perm filename FPRINT.IL[TIM,LSP] blob
sn#735362 filedate 1983-12-12 generic text, type T, neo UTF8
(FILECREATED " 5-JUL-83 14:29:33" {PHYLUM}<GABRIEL>FPRINT.;4 2137
changes to: (VARS FPRINTCOMS TESTATOMS)
(FNS FPRINT INIT INIT1)
previous date: " 5-JUL-83 14:13:19" {PHYLUM}<GABRIEL>FPRINT.;3)
(PRETTYCOMPRINT FPRINTCOMS)
(RPAQQ FPRINTCOMS ((FNS INIT INIT1 FPRINT)
(VARS TESTATOMS (TESTPATTERN (INIT 6 6 TESTATOMS)))
(P (COND ((INFILEP (QUOTE FPRINT.TST)))
(T (PROG ((F (OPENFILE (QUOTE FPRINT.TST)
(QUOTE OUTPUT))))
(PRINT TESTPATTERN F)
(CLOSEF F)))))
(GLOBALVARS TESTATOMS TESTPATTERN)))
(DEFINEQ
(INIT
(LAMBDA (M N ATOMS) (* JonL " 5-JUL-83 13:47")
(PROG ((ATOMS (SUBST NIL NIL ATOMS)))
(RETURN (INIT1 M N
(bind (A ← ATOMS)
do
(pop A)
until (NULL (CDR A)) finally
(RETURN (RPLACD A ATOMS))))))
))
(INIT1
(LAMBDA (M N ATOMS) (* JonL " 5-JUL-83 13:26")
(COND
((ZEROP M)
(POP ATOMS))
(T (bind A for I from N by -2 until (ILESSP I 1)
do (push A (pop ATOMS))
(push A (INIT1 (SUB1 M)
N ATOMS))
finally (RETURN A))))))
(FPRINT
(LAMBDA NIL (* JonL " 5-JUL-83 14:24")
(PROG ((F (INFILEP (QUOTE FPRINT.TST))))
(COND
(F (DELFILE F)))
(SETQ F (OPENFILE (QUOTE FPRINT.TST)
(QUOTE OUTPUT)))
(PRINT TESTPATTERN F)
(RETURN (CLOSEF F)))))
)
(RPAQQ TESTATOMS (ABCDEF12 CDEFGH23 EFGHIJ34 GHIJKL45 IJKLMN56 KLMNOP67 MNOPQR78 OPRST89 QRSTUV90
STUVWX01 UVWXYZ12 WXYZAB23 XYZABC34 123456AB 234567BC 345678CD 456789DE
567890EF 678901FG 789012GH 890123HI))
(RPAQ TESTPATTERN (INIT 6 6 TESTATOMS))
(COND ((INFILEP (QUOTE FPRINT.TST)))
(T (PROG ((F (OPENFILE (QUOTE FPRINT.TST)
(QUOTE OUTPUT))))
(PRINT TESTPATTERN F)
(CLOSEF F))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS TESTATOMS TESTPATTERN)
)
(PUTPROPS FPRINT COPYRIGHT (NONE))
(DECLARE: DONTCOPY
(FILEMAP (NIL (574 1564 (INIT 584 . 881) (INIT1 883 . 1238) (FPRINT 1240 . 1562)))))
STOP